Aminet 2/Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso/Aminet/biz/misc/HomeAccountant11.lha/The Home Accountant/Acct.AMOS/Acct.amosSourceCode

AMOS Source Code | 1993-09-21 | 71KB | 2,406 lines

'
'
'
'                  The Home Accountant v1.0 - by Vincent Platt
'                           (c)  DragonWarez 1992-1993
'
'
'
' ***********************  initialization begin  ************************
Set Buffer 70 : Rem enough for 1000 records
A#=0.0
Fix(2) : Rem limits floating point #'s to two digits
Global BASE$,BASEDIR$,BASEFILE$,H0MEY,PROG$,VER$
Global B1,B2,B3,R1,R2,R3,H1,H2,H3,M1,M2,M3,_MOUSE
Global LP,PAG,FF,SORETED,MXENTRIES,ACCTWRK$,DEF_ENTRIES,LAST_DATE$,LAST_DESCR$
Proc INIT : Rem this needs to be here in order to get the correct value of mxentries
Dim DATE$(MXENTRIES),DESCR$(MXENTRIES),DEBIT#(MXENTRIES),CREDIT#(MXENTRIES),DISPLAY(MXENTRIES)
Dim DESCRIPTOR$(10),COMMENT$(10),GOAL(10),BASE_ACCT$(10)
Dim CAT_TOTALS_DEB#(10),CAT_TOTALS_CRED#(10)
Dim CAT_PERCEN_DEB#(10),CAT_PERCEN_CRED#(10)
Global ACCT$,BGT$,RECNUM,TYPE$,DATE$(),DESCR$(),DEBIT#(),CREDIT#(),DISPLAY(),BASE_ACCT$()
Global CAT_TOTALS_DEB#(),CAT_TOTALS_CRED#()
Global CAT_PERCEN_DEB#(),CAT_PERCEN_CRED#()
Global DISP_TOP,DISP_BOTTOM,VIRT_IDX,PAD
Global DESCRIPTOR$(),COMMENT$(),GOAL(),BGT$,CUR_ACCT
Global R_OT,R_OBA,R_OBU,R_SP,ALL_BALANCE#
'
DISP_TOP=6 : DISP_BOTTOM=23 : Rem data is displayed on editing screen from lines 6 to 23
VIRT_IDX=1 : Rem this puts us at the first location of display()
DISPLAY(VIRT_IDX)=1 : Rem this sets up our first element in display()
'
'
Procedure VAR_D0CS
   ' base$ is the pathname of the last transaction base that was loaded
   ' basedir$ is just the path of the base$ - filename is truncated
   ' basefile$ - is just the file of the base$ - path is truncated
   ' h0mey is a boolean which shows whether or not h0mescreen is being up to date
   ' prog$ gives the program name
   ' ver$ gives the version of prog$
   ' acct$ holds the name of the current/last acct that was edited
   ' recnum gives the # of entries in current/last acct that was edited
   ' type$ gives the type of account: "Asset" or "Liability"
   ' date$() is the list of dates from the current/last acct
   ' descr$() is the list of descriptions from the current/last acct
   ' debit() is the list of debits from the current/last acct
   ' credit() is the list of credits from the current/last acct
   ' display() is the list of index numbers which appear on the screen
   ' Ex:  display(1)=55 shows that record #55 is line 1 of display()
   ' display() is actually a virtual screen as the whole thing can't be displayed at once
   ' acctwrk$ holds last acct name touched by another function besides edit
   ' prefs globals:
   ' for colors - b1,b2,b3,r1,r2,r3,h1,h2,h3,m1,m2,m3
   ' for printer defaults - lp,pag,ff
   ' for acct transaction sorting (T/F) - soreted
   ' for max # of entries in an acct - mxentries
   ' for type of mouse pointer to use - _mouse:
   '     1 = arrow (default)
   '     2 = crosshairs
   '     3 = system mouse pointer
   ' for default values given to inputs - def_entries
   '     1 = blank or zeros (default)
   '     2 = last value entered
   '     3 = "None" or zeros
   ' for holding the previous values input into a data line in the account editor
      ' - last_date$, last_descr$
   '
   ' disp_top shows the literal of the top of our editing window
   ' disp_bottom shows the literal of the bottom of our editing window
   ' virt_idx shows where we are on in the virtual screen display()
   ' pad - boolean which shows whether or not user is in keypad mode in the edit screen
   ' descriptor$(), comment$(), goal() is for the budget editor
   ' bgt$ holds name of current budget file
   ' base_account$ - holds names of accts in current transaction base
   ' cur_acct - used for indexing in the base editor
   ' for reports:
   'r_ot - output transactions?
   'r_oba - output balance?
   'r_obu - output budget info?
   'r_sp - output to screen or printer?
   'all_balance# - transaction base worth
   '
   'cat_totals_deb#(),cat_totals_cred#() - for showing the totals of each category of which there can be ten (budgets)
   'cat_percen_deb#(),cat_percen_cred#() - shows how much of debits/credits that a category takes of the account total for debits/credits
End Proc
Procedure COMMENTS
   '
   '1)
   ' there are 4 different types of files used in this programs for input and
   ' they all have the following headers (though content afterwards varies):
   '
   '        prog$+" "+"{Base, Acct, Prefs, Budget}"
   '        ver$
   ' this uniformity in headers will allow future versions to ID these files
   '  and convert or use them
   '
   '
   '2)
   '  approximately 15 records will fit into each K of memory.
   '
   '3)
   '  each transaction base is meant to cover only one money tool (e.g. checking, savings, etc.)
   '
   '4)
   '  colors:
   '             #      purpose
   '
   '             0      background
   '             1      regular
   '             2      highlight
   '             3      menu
   '
End Proc
Procedure INIT
   PROG$="The Home Accountant"
   VER$="1.1"
   Screen Open 0,640,200,4,Hires
   Palette 0,0,0,0 : Cls
   Flash Off : Rem necessary to manipulate color #3
   If Exist("s:HomeAccountant.prefs")
      PREFS_LOAD["s:HomeAccountant.prefs"]
   Else
      PREFS_DEFAULT
   End If
   Curs Off
   Pen 1 : Paper 0 : Cls
   R_OT=False : R_OBA=True : R_OBU=True : R_SP=True
   H0MEY=False
End Proc
'*************************  initialization end  **************************
'
'
'*************************  main run loop begin  *************************
On Error Proc ERR_CATCH : Rem this routine simply notifies of the error and attempts to redo the line which created the error, may cause an endless loop
Break Off : Rem we turn off the control-c to save cpu and prevent incomplete files and such
If Not Exist("libs:mathtrans.library")
   N0TICE["I need libs:mathtrans.library to function correctly.",0]
   N0TICE["Unless you have preloaded it, I may quit unexpectedly.",0]
End If
_STARTING_POINT:
Proc MENU
Goto _STARTING_POINT
'*************************  main run loop end  ***************************
'
'
'*************************  procs begin  *********************************
Procedure H0MESCREEN
   Curs Off
   Screen 0
   Cls
   Locate ,7 : Centre("Welcome to ") : Print
   Locate 27, : Pen 2 : Print PROG$;" v";VER$ : Pen 1
   B$=Chr$(169)+" 1992, 1993 DragonWarez"
   Locate ,9 : Centre B$
   Locate ,12 : Centre "Make your choice from above."
   H0MEY=True
End Proc
Procedure MENU
   BEGINMENU:
   If Not(H0MEY) Then H0MESCREEN
   Menu Del
   Pen 3
   Menu Static 2 : Rem lock all menus into place
   Inverse On
   Menu$(1)=" File "
   Menu$(1,1)=" Open Existing Transaction Base  o "
   Menu Key(1,1) To 24
   Menu$(1,2)=" Create New Transaction Base     c "
   Menu Key(1,2) To 51
   Menu$(1,3)=" Quit                            z "
   Menu Key(1,3) To 49
   Menu$(1,4)=" About                           a "
   Menu Key(1,4) To 32
   Menu$(2)=" Editing "
   Menu$(2,1)=" Edit Transaction Base      t "
   Menu Key(2,1) To 20
   Menu$(2,2)=" Edit An Account            e "
   Menu Key(2,2) To 18
   Menu$(2,3)=" Edit A Budget              b "
   Menu Key(2,3) To 53
   Menu$(3)=" Reports "
   Menu$(3,1)=" For a single account              i "
   Menu Key(3,1) To 23 : Rem "i"
   Menu$(3,2)=" For the whole transaction base    r "
   Menu Key(3,2) To 19 : Rem "r"
   '
   '
   ' prefs is #8 because we may want to use 9 for " Help " and this leaves
   '   #'s 4-7 open for future add-ons
   Menu$(8)=" Prefs "
   Menu$(8,1)=" Colors            1 "
   Menu Key(8,1) To 1
   Menu$(8,2)=" Printer Setup     2 "
   Menu Key(8,2) To 2
   Menu$(8,3)=" Sorting           3 "
   Menu Key(8,3) To 3
   Menu$(8,4)=" Max # of Entries  4 "
   Menu Key(8,4) To 4
   Menu$(8,5)=" Default Entries   5 "
   Menu Key(8,5) To 5
   Menu$(8,6)=" Mouse Pointer     6 "
   Menu Key(8,6) To 6
   Menu$(8,7)=" Load Prefs        7 "
   Menu Key(8,7) To 7
   Menu$(8,8)=" Save Prefs        8 "
   Menu Key(8,8) To 8
   Menu$(8,9)=" Default Prefs     9 "
   Menu Key(8,9) To 9
   Inverse Off
   Menu On
   Pen 1
   '
   Do
      Multi Wait
      If Not(H0MEY) Then H0MESCREEN
      Do
         Multi Wait
         Exit If Choice
      Loop
      Menu Off
      '
      If Choice(1)=1
         If Choice(2)=1
            BASE_OPEN
         End If
         If Choice(2)=2
            BASE_CREATE[""]
         End If
         If Choice(2)=3
            QUIT
         End If
         If Choice(2)=4
            ABOUT
         End If
      End If
      '
      If Choice(1)=2
         If Choice(2)=1
            BASE_EDIT
         End If
         If Choice(2)=2
            ' for this one we need to actually destroy the current menu
            '    then leave this proc in a linear non-returnable fashion
            Menu Off : Menu Del : Cls
            ACCT_EDIT_OPEN[""]
            If Param : Rem if acct_edit_open succeeded
               H0MEY=False : Rem reset the screen when we get there
               Proc ACCT_EDIT : ACCT_EDIT_QUIT
            Else
               H0MEY=False
               ACCT$="" : Rem return it to normal just in case anything checks to see if it's empty
            End If
            Goto BEGINMENU
         End If
         If Choice(2)=3
            BUDGET
         End If
      End If
      '
      If Choice(1)=3
         If Choice(2)=1
            REPORT_ACCT
         End If
         If Choice(2)=2
            REPORT_ALL
         End If
      End If
      '
      If Choice(1)=8
         If Choice(2)=1
            PREFS_COLORS
         End If
         If Choice(2)=2
            PREFS_PRINTER
         End If
         If Choice(2)=3
            PREFS_SORTING
         End If
         If Choice(2)=4
            PREFS_MAXENTRIES
         End If
         If Choice(2)=5
            PREFS_DEF_VALUES
         End If
         If Choice(2)=6
            PREFS_MOUSE
         End If
         If Choice(2)=7
            PREFS_LOAD[""]
         End If
         If Choice(2)=8
            PREFS_SAVE
         End If
         If Choice(2)=9
            PREFS_DEFAULT
         End If
      End If
      '
      Menu On
   Loop
   ' this instruction only executed when menu option 2,3 selected which breaks
End Proc
Procedure ERR_CATCH
   N0TICE["Error #"+Right$(Str$(Errn),2)+" has occured.  Contact the author.",0]
   N0TICE["Attempting to resume activity.",0]
   Resume
End Proc
Procedure ABOUT
   H0MEY=False : Cls
   Locate 0,1
   Pen 2
   Centre(PROG$+" "+VER$) : Print
   Centre("About Screen")
   Centre(Chr$(169)+" 1992, 1993 DragonWarez")
   Print : Print : Print : Print : Pen 1
   Centre("    This program is Freeware and offered to the Amiga community free of charge.") : Print
   Centre("    No charge is to be made for this program distribution.") : Print : Print
   Print "     To contact me by mail my address is:" : Print
   Print "                             Vincent Platt"
   Print "                             908 - 18th St North"
   Print "                             Moorhead, MN  56560"
   Print "                             USA" : Print : Print
   Print "     By email on the Internet my address is:" : Print
   Print "                             [e-mail]"
   CONTINUE
End Proc
'
' the following procs cover the use of transaction bases
Procedure BASE_OPEN
   H0MEY=False
   Clear Key
   TMP$=Fsel$("","","Choose your Transaction Base","(directory)")
   If TMP$="" Then Pop Proc
   If Exist(TMP$)
      Open In 1,TMP$
      Input #1,CK$
      If CK$<>(PROG$+" Base")
         N0TICE["You have not chosen a transaction base.",0]
         Close 1 : Pop Proc
      End If
      Input #1,V$ : Rem versions don't matter yet
      Input #1,BASEDIR$
      For X=1 To 10
         Input #1,BASE_ACCT$(X)
      Next X
      Close 1
      BASE$=TMP$ : Rem ok to make it global now
      ' find the basefile$
      G_NAME[TMP$,"file"]
      BASEFILE$=Param$
      Pop Proc
   End If
   _NEWBASE:
   Cls
   YN["No such base.  Would you like me to create it?"]
   If Param
      BASE_CREATE[TMP$]
   Else
      Pop Proc
   End If
End Proc
Procedure BASE_CREATE[TMP$]
   H0MEY=False : If TMP$<>"" Then Goto A
   Clear Key
   TMP$=Fsel$("","","Select new base's location and name.","")
   If TMP$="" Then Pop Proc
   If Exist(TMP$)
      YN["Do you want to write over "+TMP$+"?"]
      If Not Param
         Pop Proc
      End If
   End If
   If(Param) or(TMP$<>"")
      A:
      ' make dir "new" then make file "new.Base"
      Mkdir TMP$ : BASEDIR$=TMP$
      TMP$=TMP$+".Base"
      Open Out 1,TMP$
      Print #1,PROG$+" Base" : Print #1,VER$ : Print #1,BASEDIR$
      ' set up our globals for the base strings
      BASE$=TMP$
      G_NAME[TMP$,"file"] : BASEFILE$=Param$
      For X=1 To 10
         Print #1,BASE_ACCT$(X)
      Next X
      Close 1
      ' this is a success test since mkdir doesn't return a value
      If Not Exist(BASEDIR$)
         N0TICE["Invalid base name.  Write failed.",0]
         BASE$="" : BASEDIR$="" : BASEFILE$=""
         Pop Proc
      End If
   End If
End Proc
Procedure BASE_SAVE[TMP$]
   N0TICE["Saving transaction base: "+TMP$+".",1]
   Open Out 1,TMP$ : Print #1,PROG$+" Base" : Print #1,VER$ : Print #1,BASEDIR$
   For X=1 To 10
      Print #1,BASE_ACCT$(X)
   Next X
   Close 1
End Proc
Procedure BASE_EDIT
   If BASE$=""
      N0TICE["You do not have a Transaction Base opened.",0]
      YN["Would you like to open one?"]
      If Param
         BASE_OPEN
      End If
   End If
   If BASE$=""
      Pop Proc
   End If
   Cls
   Reserve Zone
   Reserve Zone 14
   _REFRESHSCREEN:
   Cls
   Locate ,2
   Centre(Border$("Transaction Base Editing Screen",1))
   For Y=1 To 10
      If BASE_ACCT$(Y)=""
         C$=Space$(50)
      Else
         C$=BASE_ACCT$(Y)
      End If
      A$=Chr$(176)+"  "+C$
      Locate 1,Y+7 : Print Zone$(A$,Y)
   Next Y
   Locate 9,20 : Print Border$(Zone$("SAVE",11),1)
   Locate 28,20 : Print Border$(Zone$("ADD",12),1)
   Locate 46,20 : Print Border$(Zone$("DELETE",13),1)
   Locate 65,20 : Print Border$(Zone$("QUIT",14),1)
   CUR_ACCT=0
   Do
      Multi Wait
      M=Mouse Zone
      If Mouse Click
         If(M=>1) and(M<=10)
            ' turn new one on, turn old one off, then switch the pointer
            ' find shape of new one then turn it on
            If BASE_ACCT$(M)=""
               C$=Space$(50)
            Else
               C$=BASE_ACCT$(M)
            End If
            A$=Chr$(176)+"  "+C$
            Locate 1,M+7 : Inverse On : Print Zone$(A$,M) : Inverse Off
            ' find shape of old one then turn it off
            If CUR_ACCT<>0
               If BASE_ACCT$(CUR_ACCT)=""
                  C$=Space$(50)
               Else
                  C$=BASE_ACCT$(CUR_ACCT)
               End If
               A$=Chr$(176)+"  "+C$
               Locate 1,CUR_ACCT+7 : Print Zone$(A$,CUR_ACCT)
            End If
            ' if we reselected this switch then we are trying to turn it off:= cur_Acct=0
            If CUR_ACCT=M
               CUR_ACCT=0
            Else
               CUR_ACCT=M
            End If
         End If
         If M=11
            BASE_SAVE[BASE$]
            Goto _REFRESHSCREEN
         End If
         If(M=12) and(CUR_ACCT<>0)
            If BASE_ACCT$(CUR_ACCT)<>""
               N0TICE["You must delete the current account before you add an account in its place.",0]
               Goto _REFRESHSCREEN
            End If
            ACCT_ADD
            BASE_ACCT$(CUR_ACCT)=Param$
            ' prevent a faulty name, or having the base chosen by accident
            If(Right$(BASE_ACCT$(CUR_ACCT),1)="/") or(BASE$=BASE_ACCT$(CUR_ACCT))
               BASE_ACCT$(CUR_ACCT)=""
            End If
            Goto _REFRESHSCREEN
         End If
         If(M=13) and(CUR_ACCT<>0)
            ' empty the string
            BASE_ACCT$(CUR_ACCT)=""
            Goto _REFRESHSCREEN
         End If
         If M=14
            BASE_SAVE[BASE$]
            H0MEY=False : Pop Proc : Rem in case we said no to save
         End If
      End If
   Loop
   Reserve Zone : H0MEY=False
End Proc
Procedure QUIT
   YN["Are you sure you want to quit?"]
   If Param Then Cls : Screen Close 0 : Edit
End Proc
'
'
' the following procs cover the use of accounts
Procedure ACCT_ADD
   Clear Key
   ACCTWRK$=Fsel$(BASEDIR$,"Unnamed","Give name for new acc't.","")
   If ACCTWRK$="" Then Pop Proc
   ' here it is possible to add in an account which already exists, we check it to be sure it is an account
   If Exist(ACCTWRK$)
      Open In 1,ACCTWRK$
      Line Input #1,P$
      Close 1
      If P$<>(PROG$+" Acct")
         N0TICE["This is not an account.  Operation terminated.",0]
         ACCTWRK$="" : Goto _ENDING
      End If
      Goto _ENDING
   Else
      ACCTWRK$=ACCTWRK$+".Acct"
      Open Out 1,ACCTWRK$
      Print #1,PROG$+" Acct"
      Print #1,"new" : Rem normally this is the version string
      Print #1,1 : Rem this is the actual number of records
      Print #1,SORETED
      Print #1,"Liability"
      Close 1
   End If
   ' this is a success test since mkdir doesn't return a value
   If Not(Exist(ACCTWRK$))
      N0TICE["Invalid directory name.  Create failed.",0]
      ACCTWRK$=""
      Pop Proc
   End If
   _ENDING:
End Proc[ACCTWRK$]
Procedure ACCT_EDIT
   ' this part initializes the screen
   Menu Off : Menu Del
   Pen 3 : Inverse On
   Menu$(1)=" File "
   Menu$(1,1)=" Open Acct            o "
   Menu Key(1,1) To 24
   Menu$(1,2)=" Save Current Acct    s "
   Menu Key(1,2) To 33
   Menu$(1,3)=" Quit Edit            q "
   Menu Key(1,3) To 16
   Menu$(1,4)=" View Acct Balance    v "
   Menu Key(1,4) To 52
   Menu$(2)=" Edit "
   Menu$(2,1)=" Kill A Transaction   k "
   Menu$(2,2)=" Insert A Transaction i "
   Menu$(2,3)=" Change Account Type  t "
   Menu$(2,4)=" Refresh Screen       r "
   Menu$(2,5)=" Move up the list     Up-Arrow   "
   Menu$(2,6)=" Move down the list   Down-Arrow "
   Menu$(2,7)=" Edit current entry   Return     "
   PAD=False : Rem default value
   Menu$(2,8)=" Turn Keypad Mode ON    F1       "
   Menu Key(2,1) To 39
   Menu Key(2,2) To 23
   Menu Key(2,3) To 20
   Menu Key(2,4) To 19
   Menu Key(2,5) To 76
   Menu Key(2,6) To 77
   Menu Key(2,7) To 68
   Menu Key(2,8) To 80
   Inverse Off
   ' here is our central choice routine
   '  - it allows use of the menus, up/down arrow keys, and return
   _STARTOFMENU:
   Do
      Multi Wait
      Menu On
      Clear Key
      If Not H0MEY
         ACCT_EDIT_REFRESH
      End If
      Do
         Multi Wait
         Exit If Choice
      Loop
      Menu Off
      If Choice(1)=1
         If Choice(2)=1
            ACCT_EDIT_QUIT
            Cls
            ACCT_EDIT_OPEN[""]
            ACCT_EDIT_REFRESH
         End If
         If Choice(2)=2
            ACCT_EDIT_SAVE
         End If
         If Choice(2)=3
            Exit
         End If
         If Choice(2)=4
            ACCT_EDIT_BALANCE[True]
         End If
      End If
      If Not PAD
         If Choice(1)=2
            If Choice(2)=1
               ACCT_EDIT_KILL
            End If
            If Choice(2)=2
               ACCT_EDIT_INSERT
            End If
            If Choice(2)=3
               If TYPE$="Liability"
                  TYPE$="Asset"
               Else
                  TYPE$="Liability"
               End If
               Locate 60,3 : Print Space$(15)
               Locate 60,3 : Print "Type: ";TYPE$
            End If
            If Choice(2)=4
               H0MEY=False
               ACCT_EDIT_REFRESH
            End If
            If Choice(2)=5
               ACCT_EDIT_UP
            End If
            If Choice(2)=6
               ACCT_EDIT_DOWN
            End If
            If Choice(2)=7
               ACCT_EDIT_CURRENT
            End If
            If Choice(2)=8
               PAD=True : Menu Del(2)
               Pen 3 : Inverse On
               Menu$(2)=" Keypad Options "
               Menu$(2,1)=" Insert        + "
               Menu$(2,2)=" Kill          - "
               Menu$(2,3)=" Up            Cursor-Up "
               Menu$(2,4)=" Down          Cursor-Down "
               Menu$(2,5)=" Beginning     Home "
               Menu$(2,6)=" End           End "
               Menu$(2,7)=" Refresh       * "
               Menu$(2,8)=" Edit Current  Enter "
               Menu$(2,9)=" Page up       PgUp "
               Menu$(2,10)=" Page Down     PgDn "
               Menu$(2,11)=" Turn Keypad Mode OFF   F1 "
               Inverse Off : Pen 1
               Menu Key(2,1) To 94
               Menu Key(2,2) To 74
               Menu Key(2,3) To 62
               Menu Key(2,4) To 30
               Menu Key(2,5) To 61
               Menu Key(2,6) To 29
               Menu Key(2,7) To 93
               Menu Key(2,8) To 67
               Menu Key(2,9) To 63
               Menu Key(2,10) To 31
               Menu Key(2,11) To 80
               Goto _STARTOFMENU
            End If
         End If
         ' if pad
      Else
         If Choice(1)=2
            If Choice(2)=1
               ACCT_EDIT_INSERT
            End If
            If Choice(2)=2
               ACCT_EDIT_KILL
            End If
            If Choice(2)=3
               ACCT_EDIT_UP
            End If
            If Choice(2)=4
               ACCT_EDIT_DOWN
            End If
            If Choice(2)=5
               ACCT_EDIT_HOME
            End If
            If Choice(2)=6
               ACCT_EDIT_END
            End If
            If Choice(2)=7
               H0MEY=False
               ACCT_EDIT_REFRESH
            End If
            If Choice(2)=8
               ACCT_EDIT_CURRENT
            End If
            If Choice(2)=9
               ACCT_EDIT_PGUP
            End If
            If Choice(2)=10
               ACCT_EDIT_PGDN
            End If
            If Choice(2)=11
               PAD=False : Menu Del(2)
               ' put old type menus here with old scancodes
               Pen 3 : Inverse On
               Menu$(2)=" Edit "
               Menu$(2,1)=" Kill A Transaction   k "
               Menu$(2,2)=" Insert A Transaction i "
               Menu$(2,3)=" Change Account Type  t "
               Menu$(2,4)=" Refresh Screen       r "
               Menu$(2,5)=" Move up the list     Up-Arrow  "
               Menu$(2,6)=" Move down the list   Down-Arrow "
               Menu$(2,7)=" Edit current entry   Return     "
               Menu$(2,8)=" Turn Keypad Mode ON    F1 "
               Inverse Off : Pen 1
               Menu Key(2,1) To 39
               Menu Key(2,2) To 23
               Menu Key(2,3) To 20
               Menu Key(2,4) To 19
               Menu Key(2,5) To 76
               Menu Key(2,6) To 77
               Menu Key(2,7) To 68
               Menu Key(2,8) To 80
               Goto _STARTOFMENU
            End If
         End If
      End If
      Clear Key
      Menu On
   Loop
   '
   '
   H0MEY=False
End Proc
'
' these procedures pertain only to proc acct_edit
Procedure ACCT_EDIT_OPEN[FILE$]
   RET=True
   Clear Key
   If FILE$=""
      FILE$=Fsel$(BASEDIR$,"","Choose Account","")
   End If
   If FILE$=""
      RET=False
      Goto _ENDING
   End If
   If Not Exist(FILE$)
      N0TICE["Account does not exist.",0]
      RET=False
      Goto _ENDING
   End If
   ACCT$=FILE$ : Rem make it global since it's ok now
   'read in checking string
   Open In 1,ACCT$
   Line Input #1,CK$
   If CK$<>(PROG$+" Acct")
      N0TICE["This is not a Home Accountant Account File.",0]
      Close 1 : RET=False : Goto _ENDING
   End If
   ' here we read in the rest of the header, but version is ignored
   '  because we don't care at this point.
   Line Input #1,V$
   Line Input #1,RECNUM,INS,TYPE$
   ' clear out previous data before getting new data
   '  we put this here because we need to absolutely be sure its a valid
   '   load before we clear data - this way if it's a bad load then we can
   '   keep our present data
   For X=1 To MXENTRIES Step 1
      DATE$(X)="" : DESCR$(X)="" : DEBIT#(X)=0.0 : CREDIT#(X)=0.0
   Next X
   If V$="new"
      Goto _CLEAROTHERS : Rem we're done loading if its new
   End If
   If RECNUM>MXENTRIES
      N0TICE["Too many records in Account File.  Redo prefs then restart Home Accountant.",0]
      A$=Str$(RECNUM)
      N0TICE[ACCT$+" has "+A$+" records.",0]
      Close 1 : RET=False : Goto _ENDING
   End If
   If INS<>SORETED
      YN["Change sort pref to that of the account?"]
      If Param
         SORETED=INS
      End If
   End If
   N0TICE["Loading "+ACCT$+".",1]
   For X=1 To RECNUM Step 1
      ' get out if file pointer is at end - data or no data
      If Eof(1)
         Goto _CLEAROTHERS
      End If
      Line Input #1,DATE$(X),DESCR$(X),DEBIT#(X),CREDIT#(X)
      DISPLAY(X)=X : Rem display() now equals correct order because at first we want them as input
   Next X
   _CLEAROTHERS:
   Close 1
   ' we send it down here so the value may be returned w/ the end proc statement
   _ENDING:
End Proc[RET]
Procedure ACCT_EDIT_SAVE
   If ACCT$<>""
      N0TICE["File being saved as "+ACCT$+".",1]
      Open Out 1,ACCT$
      Print #1,PROG$+" Acct"
      Print #1,VER$
      Print #1,RECNUM
      Print #1,SORETED
      Print #1,TYPE$
      ' this is here to make sure the first record gets saved if recnum=1
      CUR=DISPLAY(1)
      If RECNUM=1
         Print #1,DATE$(CUR)
         Print #1,DESCR$(CUR)
         Print #1,DEBIT#(CUR)
         Print #1,CREDIT#(CUR)
         Goto _ENDING
      End If
      If SORETED=True
         ACCT_EDIT_SORT
      End If
      N0TICE["Writing records...",1]
      For X=1 To RECNUM Step 1
         ' strip out blank records
         If Not((DATE$(X)="") and(DESCR$(X)="") and(DEBIT#(X)=0) and(CREDIT#(X)=0))
            Print #1,DATE$(X)
            Print #1,DESCR$(X)
            Print #1,DEBIT#(X)
            Print #1,CREDIT#(X)
         End If
      Next X
      _ENDING:
      Close 1
   End If
End Proc
Procedure ACCT_EDIT_SORT
   N0TICE["Sorting records...",1]
   For LUPE1=1 To(RECNUM-1)
      SMALL=LUPE1
      For LUPE2=(LUPE1+1) To RECNUM
         If(DATE$(LUPE2))<(DATE$(SMALL))
            SMALL=LUPE2
         Else
            If DATE$(LUPE2)=DATE$(SMALL)
               If DESCR$(LUPE2)=DESCR$(SMALL)
                  SMALL=LUPE2
               End If
            End If
         End If
      Next LUPE2
      Swap DATE$(LUPE1),DATE$(SMALL)
      Swap DESCR$(LUPE1),DESCR$(SMALL)
      Swap DEBIT#(LUPE1),DEBIT#(SMALL)
      Swap CREDIT#(LUPE1),CREDIT#(SMALL)
   Next LUPE1
   ' this resets the display to a sorted display
   For X=1 To RECNUM
      DISPLAY(X)=X
   Next X
   VIRT_IDX=1 : Rem start display with first record in display()
End Proc
Procedure ACCT_EDIT_QUIT
   H0MEY=False
   YN["Would you like to save first?"]
   If Param
      ACCT_EDIT_SAVE
   End If
   ACCT$=""
End Proc
Procedure ACCT_EDIT_BALANCE[ALL]
   ALL_CREDIT#=0.0
   ALL_DEBIT#=0.0
   For X=1 To MXENTRIES
      ALL_CREDIT#=ALL_CREDIT#+CREDIT#(X)
      ALL_DEBIT#=ALL_DEBIT#+DEBIT#(X)
   Next X
   If ALL
      Cls
      Locate ,8
      H0MEY=False
      Centre(Border$("Balance for: "+ACCT$+".",1))
      Locate ,12
   End If
   BAL#=ALL_CREDIT#-ALL_DEBIT#
   B$=Str$(BAL#)
   If ALL
      Centre(B$)
      Locate ,20
      CONTINUE
   End If
End Proc[B$]
Procedure ACCT_EDIT_KILL
   ' clears the data out of the deleted record
   CUR=DISPLAY(VIRT_IDX) : Rem record we are about to kill is the record we are sitting on
   DATE$(CUR)="" : DESCR$(CUR)="" : DEBIT#(CUR)=0 : CREDIT#(CUR)=0 : Rem mark that data as deleted
   ' shifts display() from that record down, up towards that space to delete it from the virtual display
   For X=VIRT_IDX To MXENTRIES-1 Step 1
      DISPLAY(X)=DISPLAY(X+1)
   Next X
   'if we're at the end of list then we need to go back up one when we delete
   ' or it'll screw up our screen
   If(VIRT_IDX=RECNUM) and(RECNUM>1)
      Dec VIRT_IDX
   End If
   If RECNUM>1
      Dec RECNUM
   End If
   ACCT_EDIT_REFRESH
End Proc
Procedure ACCT_EDIT_INSERT
   'check to see if we're already at max size for the account
   'get out if we are after displaying a message
   'if display(mxentries) has something in it then our virtual screen is full
   CUR=DISPLAY(MXENTRIES)
   ' if the cur has an assigned number and there are some signs of life then, too much!!
   If(CUR<>0)
      N0TICE["You would have too many entries in your account.",0]
      N0TICE["Save your account, change your prefs, and restart.",0]
      Pop Proc
   End If
   'move display() down one line
   For X=MXENTRIES To(VIRT_IDX+1) Step -1
      DISPLAY(X)=DISPLAY(X-1)
   Next X
   '
   'find next spot in record list for new record by scanning date$ w/a loop
   'date$(x)="" and descr$(x)="" and debit(x)=0 and credit(x)=0 then good spot
   '
   ' find a good location
   For X=1 To MXENTRIES Step 1
      If(DATE$(X)="") and(DESCR$(X)="") and(DEBIT#(X)=0) and(CREDIT#(X)=0)
         DISPLAY(VIRT_IDX)=X
         Exit
      End If
   Next X
   '
   CUR=DISPLAY(VIRT_IDX)
   DATE$(CUR)="" : DESCR$(CUR)="" : DEBIT#(CUR)=0.0 : CREDIT#(CUR)=0.0
   Inc RECNUM
   ACCT_EDIT_REFRESH
   ACCT_EDIT_LINEGET
   ACCT_EDIT_REFRESH
End Proc
Procedure ACCT_EDIT_UP
   '  of the edit window then it refreshes the window one up the list - if it
   '  is at the top of the list then it just beeps atcha..
   If VIRT_IDX=1 Then Bell : Pop Proc : Rem no go if at the top already
   Dec VIRT_IDX
   ACCT_EDIT_REFRESH
End Proc
Procedure ACCT_EDIT_DOWN
   ' this is the same as acct_edit_down 'cept it works the other way...
   If VIRT_IDX=RECNUM Then Bell : Pop Proc : Rem no go if at the bottom already
   Inc VIRT_IDX
   ACCT_EDIT_REFRESH
End Proc
Procedure ACCT_EDIT_CURRENT
   'allows current record to be edited
   ACCT_EDIT_LINEGET
   ACCT_EDIT_REFRESH
   '
End Proc
Procedure ACCT_EDIT_HOME
   VIRT_IDX=1
   ACCT_EDIT_REFRESH
End Proc
Procedure ACCT_EDIT_END
   VIRT_IDX=RECNUM
   ACCT_EDIT_REFRESH
End Proc
Procedure ACCT_EDIT_PGUP
   VIRT_IDX=VIRT_IDX-18
   If VIRT_IDX<1 Then VIRT_IDX=1
   ACCT_EDIT_REFRESH
End Proc
Procedure ACCT_EDIT_PGDN
   VIRT_IDX=VIRT_IDX+18
   If VIRT_IDX>RECNUM Then VIRT_IDX=RECNUM
   ACCT_EDIT_REFRESH
End Proc
Procedure ACCT_EDIT_REFRESH
   ' we'll refresh starting with the top of the window which is 8 lines above in display()
   ' rec will be our temp indexer for display() and line is for the screen
   If Not H0MEY
      H0MEY=True
      Cls : CLEARED=True : Pen 1
      Locate 0,1
      Centre(Border$("Account Editing Screen",1)) : Print : Print
      G_NAME[ACCT$,"file"]
      Print "Account Name: ";Param$ : Locate 60,3 : Print "Type: ";TYPE$
      Under On
      Locate 2,5 : Print "Date or ID";
      Locate 13, : Print "          Description         ";
      Locate 44, : Print "    Debit    ";
      Locate 58, : Print "   Credit    "
      Under Off
      Pen 1
      Ink 1
      Locate 0,14 : Print "->"
   End If
   ' screen setup is now done
   '
   ' the virt_idx is at line 14 and the top is at disp_top so
   '  we want to start at the top of the window
   REC=VIRT_IDX-8
   For X=DISP_TOP To DISP_BOTTOM Step 1
      ' first we print just a space$ if we are in a no data area then skip to the end
      ' second, we have data so we print it out
      If(REC<1) or(REC>RECNUM) or(REC>MXENTRIES)
         If CLEARED
            Goto _ENDOFFOR
         End If
         Locate 3,X : Print Space$(8)
         Locate 14,X : Print Space$(30)
         Locate 45,X : Print Space$(12)
         Locate 59,X : Print Space$(12)
         Goto _ENDOFFOR
      End If
      '
      'get the current record from our virtual screen and print out on actual screen
      CUR=DISPLAY(REC)
      Locate 3,X : Print DATE$(CUR); : Print Space$(8-Len(DATE$(CUR)))
      Locate 14,X : Print DESCR$(CUR); : Print Space$(30-Len(DATE$(CUR)))
      Locate 45,X
      If DEBIT#(CUR)<>0.0
         S$=Right$(Str$(DEBIT#(CUR)),Len(Str$(DEBIT#(CUR)))-1)
         Print S$;
         Print Space$(12-Len(S$))
      Else
         ' this will speed whole screen refreshes
         If Not CLEARED
            Print Space$(12)
         End If
      End If
      Locate 59,X
      If CREDIT#(CUR)<>0.0
         S$=Right$(Str$(CREDIT#(CUR)),Len(Str$(CREDIT#(CUR)))-1)
         Print S$;
         Print Space$(12-Len(S$))
      Else
         If Not CLEARED
            Print Space$(12)
         End If
      End If
      _ENDOFFOR:
      'get ready for next iteration
      Inc REC
      CLEARED=False : Rem we have completed an iteration without clsing
   Next X
End Proc
Procedure ACCT_EDIT_LINEGET
   Writing 0
   CUR=DISPLAY(VIRT_IDX)
   '
   ' for each one we get the new string and place it in its destination
   '  then we change it if its empty and our pref says so
   '
   Locate 3,14
   STRINGGET[DATE$(CUR),8]
   DATE$(CUR)=Param$
   If(DEF_ENTRIES=2) and(DATE$(CUR)="")
      DATE$(CUR)=LAST_DATE$
   End If
   If(DEF_ENTRIES=3) and(DATE$(CUR)="")
      DATE$(CUR)="None"
   End If
   LAST_DATE$=DATE$(CUR)
   '
   Locate 14,14
   STRINGGET[DESCR$(CUR),29]
   DESCR$(CUR)=Param$
   If(DEF_ENTRIES=2) and(DESCR$(CUR)="")
      DESCR$(CUR)=LAST_DESCR$
   End If
   If(DEF_ENTRIES=3) and(DESCR$(CUR)="")
      DESCR$(CUR)="None"
   End If
   LAST_DESCR$=DESCR$(CUR)
   '
   If DEBIT#(CUR)=0.0
      S$=""
   Else
      S$=Right$(Str$(DEBIT#(CUR)),Len(Str$(DEBIT#(CUR)))-1)
   End If
   Locate 45,14
   STRINGGET[S$,12]
   D$=Param$
   DEBIT#(CUR)=Val(D$)
   If DEBIT#(CUR)<>0.0
      CREDIT#(CUR)=0.0
      Pop Proc
   End If
   '
   If CREDIT#(CUR)=0.0
      S$=""
   Else
      S$=Right$(Str$(CREDIT#(CUR)),Len(Str$(CREDIT#(CUR)))-1)
   End If
   Locate 59,14
   STRINGGET[S$,12]
   D$=Param$
   CREDIT#(CUR)=Val(D$)
End Proc
'
'
' the following procs cover the third column of menu options - REPORTS
Procedure REPORT_ACCT
   Reserve Zone
   Reserve Zone 6
   Cls : H0MEY=False
   _REFRESHSCREEN:
   Do
      Multi Wait
      If Not H0MEY
         Cls
         Locate ,5
         Centre(Border$("Report An Account",1))
         Locate ,8
         Inverse On : Centre(Zone$("Output Transactions?",1)) : Print : Inverse Off
         If R_OT
            Centre "Yes" : Print
         Else
            Centre "No" : Print
         End If
         Inverse On : Centre(Zone$("Output Balance?",2)) : Print : Inverse Off
         If R_OBA
            Centre "Yes" : Print
         Else
            Centre "No" : Print
         End If
         Inverse On : Centre(Zone$("Output Any Budget Info?",3)) : Print : Inverse Off
         If R_OBU
            Centre "Yes" : Print
         Else
            Centre "No" : Print
         End If
         Inverse On : Centre(Zone$("Screen or Printer?",4)) : Print : Inverse Off
         If R_SP
            Centre "Screen" : Print
         Else
            Centre "Printer" : Print : Print
         End If
         Print : Inverse On : Centre(Zone$("Start",5)) : Print : Inverse Off : Print
         Print : Inverse On : Centre(Zone$("QUIT",6)) : Print : Inverse Off
      End If
      Do
         Multi Wait
         M=Mouse Zone
         If Mouse Click
            If M=1
               If R_OT
                  R_OT=False
               Else
                  R_OT=True
               End If
               Locate ,9 : Centre(Space$(3)) : Locate ,9
               If R_OT
                  Centre("Yes")
               Else
                  Centre("No")
               End If
            End If
            If M=2
               If R_OBA
                  R_OBA=False
               Else
                  R_OBA=True
               End If
               Locate ,11 : Centre(Space$(3)) : Locate ,11
               If R_OBA
                  Centre("Yes")
               Else
                  Centre("No")
               End If
            End If
            If M=3
               If R_OBU
                  R_OBU=False
               Else
                  R_OBU=True
               End If
               Locate ,13 : Centre(Space$(3)) : Locate ,13
               If R_OBU
                  Centre("Yes")
               Else
                  Centre("No")
               End If
            End If
            If M=4
               If R_SP
                  R_SP=False
               Else
                  R_SP=True
               End If
               Locate ,15 : Centre(Space$(7)) : Locate ,15
               If R_SP
                  Centre("Screen")
               Else
                  Centre("Printer")
               End If
            End If
            If M=5
               ACCT_EDIT_OPEN[""]
               If Not Param
                  ACCT$=""
                  Goto _REFRESHSCREEN
               End If
               REPORT_ACCT_PRINT[False,False]
               Goto _REFRESHSCREEN
            End If
            If M=6
               H0MEY=False
               Exit 2
            End If
         End If
      Loop
   Loop
   H0MEY=False
End Proc
Procedure REPORT_ALL
   Reserve Zone
   Reserve Zone 6
   Cls : H0MEY=False
   _REFRESHSCREEN:
   Do
      Multi Wait
   If BASE$="" Then N0TICE["You need to open a Transaction Base first.",0] : Pop Proc
      If Not H0MEY
         Cls
         Locate ,5
         Centre(Border$("Report Current Transaction Base",1))
         Locate ,8
         Inverse On : Centre(Zone$("Output Transactions?",1)) : Print : Inverse Off
         If R_OT
            Centre "Yes" : Print
         Else
            Centre "No" : Print
         End If
         Inverse On : Centre(Zone$("Output Balance?",2)) : Print : Inverse Off
         If R_OBA
            Centre "Yes" : Print
         Else
            Centre "No" : Print
         End If
         Inverse On : Centre(Zone$("Output Any Budget Info?",3)) : Print : Inverse Off
         If R_OBU
            Centre "Yes" : Print
         Else
            Centre "No" : Print
         End If
         Inverse On : Centre(Zone$("Screen or Printer?",4)) : Print : Inverse Off
         If R_SP
            Centre "Screen" : Print
         Else
            Centre "Printer" : Print : Print
         End If
         Print : Inverse On : Centre(Zone$("Start",5)) : Print : Inverse Off : Print
         Print : Inverse On : Centre(Zone$("QUIT",6)) : Print : Inverse Off
      End If
      Do
         Multi Wait
         M=Mouse Zone
         If Mouse Click
            If M=1
               If R_OT
                  R_OT=False
               Else
                  R_OT=True
               End If
               Locate ,9 : Centre(Space$(3)) : Locate ,9
               If R_OT
                  Centre("Yes")
               Else
                  Centre("No")
               End If
            End If
            If M=2
               If R_OBA
                  R_OBA=False
               Else
                  R_OBA=True
               End If
               Locate ,11 : Centre(Space$(3)) : Locate ,11
               If R_OBA
                  Centre("Yes")
               Else
                  Centre("No")
               End If
            End If
            If M=3
               If R_OBU
                  R_OBU=False
               Else
                  R_OBU=True
               End If
               Locate ,13 : Centre(Space$(3)) : Locate ,13
               If R_OBU
                  Centre("Yes")
               Else
                  Centre("No")
               End If
            End If
            If M=4
               If R_SP
                  R_SP=False
               Else
                  R_SP=True
               End If
               Locate ,15 : Centre(Space$(7)) : Locate ,15
               If R_SP
                  Centre("Screen")
               Else
                  Centre("Printer")
               End If
            End If
            If M=5
               ALL_BALANCE#=0.0
               For X=1 To 10
                  If BASE_ACCT$(X)<>""
                     ACCT_EDIT_OPEN[BASE_ACCT$(X)]
                     If Not Param
                        N0TICE["Account: "+BASE_ACCT$(X)+" not found.",2]
                        N0TICE["It will not be reported.",2]
                        Goto _ANOTHERITERATION
                     End If
                     REPORT_ACCT_PRINT[True,False] : Rem all: yes, done: no
                  End If
                  If X=10
                     REPORT_ACCT_PRINT[True,True] : Rem all: yes, done: yes
                  End If
                  _ANOTHERITERATION:
               Next X
               Goto _REFRESHSCREEN
            End If
            If M=6
               H0MEY=False
               Exit 2
            End If
         End If
      Loop
   Loop
   H0MEY=False
End Proc
Procedure REPORT_ACCT_PRINT[ALL,_DONE]
   ' if we're here only for the base balance then go there
   If _DONE and R_OBA and ALL
      If R_SP
         Goto _SHOWBASEBALANCE
      Else
         Goto _PRINTBASEBALANCE
      End If
   End If
   ' check our pref and let it have it!
   If SORETED and R_OT
      ACCT_EDIT_SORT
   End If
   ' if printer
   If Not R_SP
      YN["Are you sure you want to send to printer?"]
      If Param
         N0TICE["Please make sure your printer is ready.",0]
         LINNUM=1 : PAGNUM=1 : Rem we're on line 1, page 1
         ' print out the header
         Lprint "Report for ";ACCT$;"  (";TYPE$;")." : Inc LINNUM
         If Not PAG
            Lprint : Lprint : LINNUM=LINNUM+2
         End If
         If PAG
            Lprint "Page: ";PAGNUM : Lprint : Lprint
            LINNUM=LINNUM+3
         End If
         If(R_OBA) and(PAGNUM=1)
            ACCT_EDIT_BALANCE[False]
            Lprint "   Balance: ";Param$
            If ALL
               B#=Val(Param$)
               If TYPE$="Asset"
                  ALL_BALANCE#=ALL_BALANCE#+B#
               Else
                  ALL_BALANCE#=ALL_BALANCE#-B#
               End If
            End If
            Inc LINNUM
         End If
         If(R_OBU) and(PAGNUM=1)
            BUDGET_LOAD[False]
            If Not Param
               Pop Proc
            End If
            REPORT_ACCT_CALC
            Lprint : Lprint Space$(3);"Budget Info:" : Lprint
            Lprint "Category     Comment                          Debit %  Credit %  Goal %"
            LINNUM=LINNUM+4
            For X=1 To 10
               A$=Str$(CAT_PERCEN_DEB#(X))
               B$=Str$(CAT_PERCEN_CRED#(X))
               C$=Str$(GOAL(X))
               Inc LINNUM
               Lprint DESCRIPTOR$(X);
               Y=10-Len(DESCRIPTOR$(X)) : If Y<0 : Y=0 : End If
               Lprint Space$(Y+3);
               Lprint COMMENT$(X);
               Y=30-Len(COMMENT$(X)) : If Y<0 : Y=0 : End If
               Lprint Space$(Y+3);
               Lprint A$;
               Y=6-Len(A$) : If Y<0 : Y=0 : End If
               Lprint Space$(Y+3);
               Lprint B$;
               Y=6-Len(B$) : If Y<0 : Y=0 : End If
               Lprint Space$(Y+4);
               Lprint C$
            Next X
            ' go to the next page
            If PAG
               For X=LINNUM To LP Step 1
                  Lprint
               Next X
               Inc PAGNUM : LINNUM=1
            End If
         End If
         If R_OT
            ' we want another page header iff we output transactions and we didn't output one because of the budget report
            If(PAG)
               Lprint "Report for ";ACCT$;"  (";TYPE$;")."
               Lprint "Page: ";PAGNUM : Lprint : Lprint
               LINNUM=LINNUM+4
            End If
            Lprint : Lprint Space$(3);"Transactions:" : Lprint
            Lprint "Date       Description                      Debit        Credit"
            Lprint
            LINNUM=LINNUM+4
            For X=1 To RECNUM
               If DEBIT#(X)<>0.0
                  A$=Str$(DEBIT#(X))
               Else
                  A$=""
               End If
               If CREDIT#(X)<>0.0
                  B$=Str$(CREDIT#(X))
               Else
                  B$=""
               End If
               Lprint Using "~~~~~~~~   ";DATE$(X);
               Lprint Using "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   ";DESCR$(X);
               Lprint Using "~~~~~~~~~~   ";A$;
               Lprint Using "~~~~~~~~~~";B$
               Inc LINNUM
               ' don't want this unless we had to do the transactions too
               If(PAG)
                  If(LINNUM=LP) or(X=RECNUM)
                     If X=RECNUM
                        For Y=LINNUM To LP
                           Lprint
                        Next Y
                        Pop Proc
                     End If
                     'if linnum = lp
                     LINNUM=1 : Inc PAGNUM
                     Lprint "Report for ";ACCT$;"  (";TYPE$;")."
                     Lprint "Page: ";PAGNUM : Lprint : Lprint
                     LINNUM=LINNUM+4
                  End If
               Next X
            End If
         End If
         Goto _NEXT
         _PRINTBASEBALANCE:
         'output balance page after finishing off the last page
         For X=LINNUM To LP
            Lprint
         Next X
         LINNUM=1 : Lprint
         A$=Str$(ALL_BALANCE#)
         Lprint "Calculated worth of ";BASE$;":";A$
      End If
      H0MEY=False
   End If
   _NEXT:
   ' if screen
   If R_SP
      Cls
      LINNUM=1 : PAGNUM=1 : Rem we're on line 1, page 1
      Print "Report for ";ACCT$;"  (";TYPE$;")." : Inc LINNUM
      If Not PAG
         Print : Print : LINNUM=LINNUM+2
      End If
      If PAG
         Print "Page: ";PAGNUM : Print : Print
         LINNUM=LINNUM+3
      End If
      If(R_OBA) and(PAGNUM=1)
         ACCT_EDIT_BALANCE[False]
         Print "   Balance: ";Param$
         If ALL
            B#=Val(Param$)
            If TYPE$="Asset"
               ALL_BALANCE#=ALL_BALANCE#+B#
            Else
               ALL_BALANCE#=ALL_BALANCE#-B#
            End If
         End If
         Inc LINNUM
      End If
      If(R_OBU) and(PAGNUM=1)
         BUDGET_LOAD[False]
         If Not Param
            Pop Proc
         End If
         REPORT_ACCT_CALC
         Print : Print Space$(3);"Budget Info:" : Print
         Print "Category     Comment                          Debit %  Credit %  Goal %"
         LINNUM=LINNUM+4
         For X=1 To 10
            A$=Str$(CAT_PERCEN_DEB#(X))
            B$=Str$(CAT_PERCEN_CRED#(X))
            C$=Str$(GOAL(X))
            Inc LINNUM
            Print DESCRIPTOR$(X);
            Y=10-Len(DESCRIPTOR$(X)) : If Y<0 : Y=0 : End If
            Print Space$(Y+3);
            Print COMMENT$(X);
            Y=30-Len(COMMENT$(X)) : If Y<0 : Y=0 : End If
            Print Space$(Y+3);
            Print A$;
            Y=6-Len(A$) : If Y<0 : Y=0 : End If
            Print Space$(Y+3);
            Print B$;
            Y=6-Len(B$) : If Y<0 : Y=0 : End If
            Print Space$(Y+4);
            Print C$
         Next X
         ' go to the next page
         If PAG
            For X=LINNUM To 22 Step 1
               Print
            Next X
            Inc PAGNUM : LINNUM=1
         End If
      End If
      ' we'll want a page break in any case after the budget report
      CONTINUE
      If Not R_OBU
         Inc PAGNUM
      End If
      If(R_OT)
         Print "Report for ";ACCT$;"  (";TYPE$;")."
         Print "Page: ";PAGNUM : Print : Print
         LINNUM=LINNUM+4
         Print : Print Space$(3);"Transactions:" : Print
         Print "Date       Description                      Debit        Credit"
         Print
         LINNUM=LINNUM+5
         For X=1 To RECNUM
            If DEBIT#(X)<>0.0
               A$=Str$(DEBIT#(X))
            Else
               A$=""
            End If
            If CREDIT#(X)<>0.0
               B$=Str$(CREDIT#(X))
            Else B$=""
            End If
            Print Using "~~~~~~~~   ";DATE$(X);
            Print Using "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   ";DESCR$(X);
            Print Using "~~~~~~~~~~   ";A$;
            Print Using "~~~~~~~~~~";B$
            Inc LINNUM
            ' don't want this unless we had to do the transactions too
            If(PAG)
               If(LINNUM=22) or(X=RECNUM)
                  CONTINUE
                  If X=RECNUM
                     Pop Proc
                  End If
                  LINNUM=1 : Inc PAGNUM
                  Print "Report for ";ACCT$;"  (";TYPE$;")."
                  Print "Page: ";PAGNUM : Print : Print
                  LINNUM=LINNUM+4
               End If
            Next X
         End If
      End If
      Goto _ENDING
      _SHOWBASEBALANCE:
      'output balance page after finishing off the last page
      Cls
      LINNUM=1 : Print
      A$=Str$(ALL_BALANCE#)
      Print "Calculated worth of ";BASE$;":";A$
      CONTINUE
   End If
   _ENDING:
End Proc
Procedure REPORT_ACCT_CALC
   ' This requires that the account file and budget files are already open
   '  for input then it performs the following 3 functions using nested loops
   ' This proc is used to calculate one account's figures.  The Report_All proc
   '  will need to use this proc in a loop to allow it success.
   ' 1. get totals of credits and debits for the account
   ' 2. get totals of credits and debits for each descriptor listed in the budget which appears in the account
   ' 3. compute %'s - = descriptor total/total for the account
   ' making sure we get clean results
   BAL_TOTALS_DEB#=0 : BAL_TOTALS_CRED#=0
   For Y=1 To 10
      CAT_TOTALS_DEB#(Y)=0 : CAT_TOTALS_CRED#(Y)=0
   Next Y
   For X=1 To RECNUM
      BAL_TOTALS_DEB#=BAL_TOTALS_DEB#+DEBIT#(X)
      BAL_TOTALS_CRED#=BAL_TOTALS_CRED#+CREDIT#(X)
      For Y=1 To 10
         If DESCR$(X)=DESCRIPTOR$(Y)
            CAT_TOTALS_DEB#(Y)=CAT_TOTALS_DEB#(Y)+DEBIT#(X)
            CAT_TOTALS_CRED#(Y)=CAT_TOTALS_CRED#(Y)+CREDIT#(X)
         End If
      Next Y
   Next X
   For X=1 To 10 Step 1
      ' prevent division by zero
      If BAL_TOTALS_DEB#>0
         CAT_PERCEN_DEB#(X)=0
         CAT_PERCEN_DEB#(X)=(CAT_TOTALS_DEB#(X)/BAL_TOTALS_DEB#)*100
      Else
         CAT_PERCEN_DEB#(X)=0
      End If
      If BAL_TOTALS_CRED#>0
         CAT_PERCEN_CRED#(X)=0
         CAT_PERCEN_CRED#(X)=(CAT_TOTALS_CRED#(X)/BAL_TOTALS_CRED#)*100
      Else
         CAT_PERCEN_CRED#(X)=0
      End If
   Next X
End Proc
'
' the following procs cover the use of budgets
Procedure BUDGET
   Cls : H0MEY=False : Rem for our purposes, will reset later
   Reserve Zone
   Reserve Zone 13
   ' need to blank this out so the last session doesn't stick around
   For X=1 To 10
      DESCRIPTOR$(X)="" : COMMENT$(X)="" : GOAL(X)=0
   Next X
   BUDGET_LOAD[True]
   If BGT$="" Then Pop Proc : Rem we require a name to get into here
   _REFRESHSCREEN:
   If Not H0MEY
      Cls
      Locate ,2
      Centre(Border$("Account Budgeting Screen",1))
      Under On
      Locate 3,5 : Print "Descriptor"
      Locate 22,5 : Print "Comment"
      Locate 55,5 : Print "Goal %"
      Under Off
      For Y=1 To 10
         Locate 1,Y+7 : Print Zone$(Chr$(176)+" "+DESCRIPTOR$(Y)+Space$(10-Len(DESCRIPTOR$(Y))),Y)
         '         Locate 3,Y+7 : Print DESCRIPTOR$(Y)
         Locate 22,Y+7 : Print COMMENT$(Y)
         Locate 55,Y+7
         If GOAL(Y)<>0
            S$=Right$(Str$(GOAL(Y)),Len(Str$(GOAL(Y)))-1)
            Print S$
         End If
      Next Y
      Locate 15,20 : Print Border$(Zone$("SAVE",11),1)
      Locate 35,20 : Print Border$(Zone$("LOAD",12),1)
      Locate 55,20 : Print Border$(Zone$("QUIT",13),1)
      H0MEY=True
   End If
   Do
      Multi Wait
      If Not H0MEY
         Goto _REFRESHSCREEN
      End If
      M=Mouse Zone
      If Mouse Click
         If(M=>1) and(M<=10)
            Locate 3,7+M
            STRINGGET[DESCRIPTOR$(M),10]
            DESCRIPTOR$(M)=Param$
            Locate 22,7+M
            STRINGGET[COMMENT$(M),30]
            COMMENT$(M)=Param$
            A:
            Locate 55,7+M
            If GOAL(M)=0
               S$=""
            Else
               ' we only want the number, we exclude the preceding space
               S$=Right$(Str$(GOAL(M)),Len(Str$(GOAL(M)))-1)
            End If
            STRINGGET[S$,3]
            S$=Param$
            GOAL(M)=Val(S$)
            If(GOAL(M)<0) or(GOAL(M)>100)
               Goto A
            End If
            H0MEY=False
         End If
         If M=11
            BUDGET_SAVE
            H0MEY=False
         End If
         If M=12
            BUDGET_LOAD[True]
            H0MEY=False
         End If
         If M=13
            YN["Would you like to save your work first?"]
            If Param
               BUDGET_SAVE
            End If
            Exit
         End If
      End If
   Loop
   Reserve Zone : H0MEY=False
End Proc
Procedure BUDGET_SAVE
   Clear Key : H0MEY=False
   N0TICE["Saving your Budget file.",1]
   Open Out 1,BGT$
   Print #1,(PROG$+" Budget")
   Print #1,VER$
   For X=1 To 10
      Print #1,DESCRIPTOR$(X)
      Print #1,COMMENT$(X)
      Print #1,GOAL(X)
   Next X
   Close 1
End Proc
Procedure BUDGET_LOAD[ALLL]
   RET=True : Rem by default the proc is successfull, unless somthing goes wrong
   Clear Key
   B$=Fsel$(BASEDIR$,"","Choose Budget.","")
   If B$=""
      RET=False : Goto _ENDING
   End If
   If ALLL
      If Not Exist(B$)
         N0TICE["That budget file does not exist.",0]
         YN["Would you like me to create it for you?"]
         If Param
            BGT$=B$
            BUDGET_SAVE
         Else
            H0MEY=False
            RET=False : Goto _ENDING
         End If
      End If
   End If
   If Not Exist(B$)
      N0TICE["That file does not exist",0]
      RET=False : Goto _ENDING
   End If
   BGT$=B$ : Rem now that we know it's valid we can save it to our global
   Open In 1,BGT$
   Line Input #1,CK$
   If CK$<>(PROG$+" Budget")
      N0TICE["This is not a Budget file.",0]
      BGT$=""
      Close 1
      RET=False : Goto _ENDING
   End If
   Line Input #1,V$ : Rem version ignored for now
   For X=1 To 10
      Line Input #1,DESCRIPTOR$(X)
      Line Input #1,COMMENT$(X)
      Line Input #1,GOAL(X)
   Next X
   Close 1
   _ENDING:
   H0MEY=False
End Proc[RET]
'
'the following procs cover the last column of menu options - PREFS
Procedure PREFS_COLORS
   'first we need to obtain the values of the current palette
   Cls
   Print : Centre(Border$("Color Prefs Screen",1))
   Locate 1,4 : Centre(Border$("Red     Green    Blue",1))
   Shade On
   Inverse On : Locate 1,8 : Centre("Background Color") : Inverse Off
   Pen 1 : Locate 1,12 : Centre("Regular Color")
   Pen 2 : Locate 1,16 : Centre("Highlight Color")
   Pen 3 : Locate 1,20 : Centre("Menu Color")
   Pen 1
   Shade Off
   Reserve Zone 25
   ' background color
   Locate 31,7 : Print Zone$("+",1)
   Locate 39,7 : Print Zone$("+",2)
   Locate 48,7 : Print Zone$("+",3)
   Locate 31,9 : Print Zone$("-",4)
   Locate 39,9 : Print Zone$("-",5)
   Locate 48,9 : Print Zone$("-",6)
   ' regular text color
   Locate 31,11 : Print Zone$("+",7)
   Locate 39,11 : Print Zone$("+",8)
   Locate 48,11 : Print Zone$("+",9)
   Locate 31,13 : Print Zone$("-",10)
   Locate 39,13 : Print Zone$("-",11)
   Locate 48,13 : Print Zone$("-",12)
   'highlighted text color
   Locate 31,15 : Print Zone$("+",13)
   Locate 39,15 : Print Zone$("+",14)
   Locate 48,15 : Print Zone$("+",15)
   Locate 31,17 : Print Zone$("-",16)
   Locate 39,17 : Print Zone$("-",17)
   Locate 48,17 : Print Zone$("-",18)
   'menu text color
   Locate 31,19 : Print Zone$("+",19)
   Locate 39,19 : Print Zone$("+",20)
   Locate 48,19 : Print Zone$("+",21)
   Locate 31,21 : Print Zone$("-",22)
   Locate 39,21 : Print Zone$("-",23)
   Locate 48,21 : Print Zone$("-",24)
   '
   Data 31,49,7,10,11,14,15,18,19,22
   Read X1,X2
   X1=X Graphic(X1) : X2=X Graphic(X2)
   Ink 1
   For N=1 To 4
      Read Y1,Y2
      Y1=Y Graphic(Y1) : Y2=Y Graphic(Y2)
      If N>1
         Ink N-1
      End If
      Box X1,Y1 To X2,Y2
   Next N
   Locate 10,12 : Print Zone$(Border$("Quit",1),25)
   Do
      Multi Wait
      M=Mouse Zone
      If Mouse Key=1
         If M=1
            If B1<15
               B1=B1+1
            End If
         End If
         If M=2
            If B2<15
               B2=B2+1
            End If
         End If
         If M=3
            If B3<15
               B3=B3+1
            End If
         End If
         If M=4
            If B1>0
               B1=B1-1
            End If
         End If
         If M=5
            If B2>0
               B2=B2-1
            End If
         End If
         If M=6
            If B3>0
               B3=B3-1
            End If
         End If
         If M=7
            If R1<15
               R1=R1+1
            End If
         End If
         If M=8
            If R2<15
               R2=R2+1
            End If
         End If
         If M=9
            If R3<15
               R3=R3+1
            End If
         End If
         If M=10
            If R1>0
               R1=R1-1
            End If
         End If
         If M=11
            If R2>0
               R2=R2-1
            End If
         End If
         If M=12
            If R3>0
               R3=R3-1
            End If
         End If
         If M=13
            If H1<15
               H1=H1+1
            End If
         End If
         If M=14
            If H2<15
               H2=H2+1
            End If
         End If
         If M=15
            If H3<15
               H3=H3+1
            End If
         End If
         If M=16
            If H1>0
               H1=H1-1
            End If
         End If
         If M=17
            If H2>0
               H2=H2-1
            End If
         End If
         If M=18
            If H3>0
               H3=H3-1
            End If
         End If
         If M=19
            If M1<15
               M1=M1+1
            End If
         End If
         If M=20
            If M2<15
               M2=M2+1
            End If
         End If
         If M=21
            If M3<15
               M3=M3+1
            End If
         End If
         If M=22
            If M1>0
               M1=M1-1
            End If
         End If
         If M=23
            If M2>0
               M2=M2-1
            End If
         End If
         If M=24
            If M3>0
               M3=M3-1
            End If
         End If
         If M=25
            Exit
         End If
      End If
      B0=((B1*256)+(B2*16)+B3)
      R0=((R1*256)+(R2*16)+R3)
      H0=((H1*256)+(H2*16)+H3)
      M0=((M1*256)+(M2*16)+M3)
      Palette B0,R0,H0,M0
      Wait 10
   Loop
   H0MEY=False
   Reserve Zone
End Proc
Procedure PREFS_PRINTER
   Reserve Zone
   Reserve Zone 3
   Cls
   _REFRESHSCREEN:
   Do
      Multi Wait
      Cls
      Locate ,5
      Centre(Border$("Printer Preferences",1))
      Locate ,10
      Inverse On : Centre(Zone$("Lines per page:",1)) : Print : Inverse Off
      Locate 37,11 : Print LP
      Inverse On : Centre(Zone$("Paginate?",2)) : Print : Inverse Off
      If PAG Then Centre "Yes" : Print
      If Not PAG Then Centre "No" : Print
      Print : Inverse On : Centre(Zone$("QUIT",3)) : Print : Inverse Off
      Do
         Multi Wait
         M=Mouse Zone
         If Mouse Click
            If M=1
               A:
               Locate 36,11 : Print "              " : Locate 37,11
               Clear Key
               Input " ";LP
               If LP<20
                  Goto A
               End If
               Curs Off : Goto _REFRESHSCREEN
            End If
            If M=2
               Locate 36,13 : Print Space$(3)
               ' first we switch the current value then we output it
               If PAG
                  PAG=False
               Else
                  PAG=True
               End If
               If PAG
                  Locate 38,13 : Print Space$(3) : Locate 38,13 : Print "Yes"
               Else
                  Locate 38,13 : Print Space$(3) : Locate 38,13 : Print "No"
               End If
            End If
            If M=3
               H0MEY=False
               Exit 2
            End If
         End If
      Loop
   Loop
   H0MEY=False
End Proc
Procedure PREFS_SORTING
   H0MEY=False
   YN["Do you want your Accounts sorted before saving/printing?"]
   If Param
      SORETED=True
   Else
      SORETED=False
   End If
End Proc
Procedure PREFS_MAXENTRIES
   H0MEY=False
   A: Cls
   Locate ,5
   Centre(Border$("Maximum Number of Entries Preference",1))
   Locate ,10
   Centre("What is the max # of entries you think you will use in an acct?") : Print
   A$=Str$(MXENTRIES)
   Centre("Currently "+A$+" is your preference.") : Print : Print
   Locate 36, : Clear Key : Input "";M
   If M=0 Then M=MXENTRIES : Pop Proc : Rem get out if no change
   If M<1 Then Goto A : Rem preventing possible logic error in i/o
   If M>1000 Then N0TICE["This version has a limit of 1000 records.",0] : Goto A
   N0TICE["You need to save your prefs file and restart to make this pref work.",0]
   MXENTRIES=M : Rem make it global now that it's ok.
End Proc
Procedure PREFS_DEF_VALUES
   Reserve Zone
   Reserve Zone 3
   Cls
   _REFRESHSCREEN:
   Do
      Multi Wait
      Cls
      H0MEY=False
      Locate ,5
      Centre(Border$("Default Entries Preference",1)) : Print : Print : Print
      Centre("Within the Account Editor, when text is prompted for and you give a") : Print
      Centre("blank answer you want the default answer to be:") : Print
      Locate ,12
      Inverse On : Centre(Zone$("Blank",1)) : Print : Print
      Centre(Zone$("Last Value Entered",2)) : Print : Print
      Centre(Zone$("`None'",3)) : Inverse Off : Print : Print
      Do
         Multi Wait
         M=Mouse Zone
         If Mouse Click
            If M=1
               DEF_ENTRIES=1 : Pop Proc
            End If
            If M=2
               DEF_ENTRIES=2 : Pop Proc
            End If
            If M=3
               DEF_ENTRIES=3 : Pop Proc
            End If
         End If
      Loop
   Loop
End Proc
Procedure PREFS_MOUSE
   Reserve Zone
   Reserve Zone 4
   Cls
   _REFRESHSCREEN:
   Do
      Multi Wait
      A:
      Cls
      H0MEY=False
      Locate ,5
      Centre(Border$("Mouse Pointer Preference",1)) : Print : Print : Print
      Locate ,12
      Inverse On : Centre(Zone$("Arrow",1)) : Print : Print
      Centre(Zone$("Crosshairs",2)) : Print : Print
      Centre(Zone$("System Pointer",3)) : Print : Print
      Centre(Zone$("QUIT",4)) : Print : Print : Inverse Off
      Do
         Multi Wait
         M=Mouse Zone
         If Mouse Click
            If M=1
               _MOUSE=1 : Change Mouse _MOUSE
            End If
            If M=2
               _MOUSE=2 : Change Mouse _MOUSE
            End If
            If M=3
               _GET_SYS_MOUSE
               ' don't change our global if the change was not successful
               If Param
                  _MOUSE=3
               Else
                  Goto A : Rem if not param then it failed and screen needs refreshing
               End If
            End If
            If M=4
               Pop Proc
            End If
         End If
      Loop
   Loop
End Proc
Procedure PREFS_LOAD[IN$]
   Clear Key
   If IN$="" Then IN$=Fsel$("","","Choose prefs file to load")
   If(IN$<>"")
      If Exist(IN$)
         Open In 1,IN$
         Line Input #1,A$
         If A$<>(PROG$+" Prefs")
            N0TICE["File not a Home Accountant prefs file.",0] : PREFS_DEFAULT
         Else
            ' this inputs the null colors too
            Line Input #1,VER$,B1,B2,B3,R1,R2,R3,H1,H2,H3,M1,M2,M3,Z,Z,Z,Z,Z,Z,Z,Z,Z,Z,Z,Z,LP,PAG,FF,SORETED,MXENTRIES,DEF_ENTRIES,_MOUSE
         End If
         Close 1
      End If
   End If
   Palette((B1*256)+(B2*16)+B3),((R1*256)+(R2*16)+R3),((H1*256)+(H2*16)+H3),((M1*256)+(M2*16)+M3) : Cls
   If _MOUSE<3 Then Change Mouse _MOUSE
   If _MOUSE=3 Then _GET_SYS_MOUSE
   H0MEY=False
End Proc
Procedure PREFS_SAVE
   Clear Key
   OUT$=Fsel$("s:","HomeAccountant.Prefs","Chooose prefs file to save")
   If(OUT$="")
      Pop Proc
   Else
      If Not(Exist(OUT$))
         A:
         Open Out 1,OUT$
         Print #1,PROG$+" Prefs"
         Print #1,VER$
         Print #1,B1
         Print #1,B2
         Print #1,B3
         Print #1,R1
         Print #1,R2
         Print #1,R3
         Print #1,H1
         Print #1,H2
         Print #1,H3
         Print #1,M1
         Print #1,M2
         Print #1,M3
         ' here's our null colors for when we go to an 8 color screen
         Print #1,0
         Print #1,0
         Print #1,0
         Print #1,0
         Print #1,0
         Print #1,0
         Print #1,0
         Print #1,0
         Print #1,0
         Print #1,0
         Print #1,0
         Print #1,0
         Print #1,LP
         Print #1,PAG
         Print #1,FF
         Print #1,SORETED
         Print #1,MXENTRIES
         Print #1,DEF_ENTRIES
         Print #1,_MOUSE
         Close 1
      Else
         N0TICE["File: "+OUT$+" already exists.",0]
         YN["Want to overwrite it?"]
         If Param
            Goto A
         End If
      End If
   End If
End Proc
Procedure PREFS_DEFAULT
   Cls
   Colour Back Colour(0)
   B1=0 : B2=0 : B3=0 : Rem black
   R1=15 : R2=0 : R3=15 : Rem purple
   H1=0 : H2=15 : H3=0 : Rem bright green
   M1=14 : M2=0 : M3=10 : Rem hot/deep pink
   Palette((B1*256)+(B2*16)+B3),((R1*256)+(R2*16)+R3),((H1*256)+(H2*16)+H3),((M1*256)+(M2*16)+M3) : Cls
   LP=66 : PAG=True : FF=True : DATEFORM$="MM/DD/YY" : SORETED=False
   MXENTRIES=500 : Rem maximum number of entries per acct
   DEF_ENTRIES=1 : _MOUSE=1 : Change Mouse _MOUSE
   H0MEY=False
End Proc
'
'
' these last procs are called by the above three sections of procs
' - g_name gives you the actual file/path name given a full pathname+file
' - n0tice gives feedback to the user about what is happening (e.g. errors, disk access, etc.)
' - yn asks a yes/no question and returns the result
' - stringget gets a string given prev_value,mxchar's
' - continue simply is used to pause the screen to let the user look b4 it cls's
' - _get_sys_mouse attempts to grab your system mouse shape and palette
Procedure G_NAME[NAME$,T$]
   ' this function is for extracting the actual file name out of a path
   '   used for referring to the accts that are path listed in the .BASE file
   '
   A=Len(NAME$)
   While((Mid$(NAME$,A,1)<>"/") and(Mid$(NAME$,A,1)<>":")) and(A<>0)
      Dec A
   Wend
   If T$="file" Then RET$=Right$(NAME$,Len(NAME$)-A)
   If T$="path" Then RET$=Left$(NAME$,A)
End Proc[RET$]
Procedure N0TICE[MSG$,T]
   ' t = ?
   '     0 : wait for keypress or mouse click
   '     1 : just show the message and leave
   '     2 : wait for 2 seconds and leave
   Curs Off : Clear Key : Bell : Cls : Locate ,10 : Pen 2 : Centre MSG$ : Pen 1
   If T=0
      Print : Print : Centre "Press a key or mouse button to continue."
   End If
   H0MEY=False
   MOUSY=0
   If T=0
      Do
         Multi Wait
         MOUSY=Mouse Click
         If MOUSY<>0
            Cls : Pop Proc
         End If
         SURE$=Inkey$
         If SURE$<>""
            Cls : Pop Proc
         End If
      Loop
   End If
   If T=2
      Wait(100)
   End If
End Proc
Procedure YN[QUESTION$]
   H0MEY=False
   Clear Key : SURE$="" : SURE=False : Rem defaults
   Cls : Locate ,10 : Pen 2 : Centre QUESTION$
   Pen 1 : Print : Centre "(Y/N) or (LMB/RMB)"
   A:
   MOUSY=0
   Do
      Multi Wait
      MOUSY=Mouse Click : If MOUSY<>0 Then Exit
      SURE$=Inkey$ : If SURE$<>"" Then Exit
   Loop
   If MOUSY=1 Then SURE=True
   If MOUSY=2 Then SURE=False
   If(SURE$<>"") and(Lower$(Left$(SURE$,1))="y") Then SURE=True
   Cls
End Proc[SURE]
Procedure STRINGGET[OBJ$,MXCHAR]
' this will input obj$ for a max of 31 chars
   Memorize X
   Memorize Y
   Clear Key
   Curs On
   'idiot proofing
   If(Len(OBJ$)>MXCHAR) or(Len(OBJ$)>31)
      OBJ$=Left$(OBJ$,Min(31,MXCHAR))
   End If
   Cline(MXCHAR)
   Put Key OBJ$
   Input "";OBJ$
   If Len(OBJ$)>MXCHAR
      OBJ$=Left$(OBJ$,Min(31,MXCHAR))
   End If
   Curs Off
End Proc[OBJ$]
Procedure CONTINUE
   Locate 0,23
   Pen 2 : Print "Press any key or mouse button to continue."; : Pen 1
   A$="" : M=0
   Clear Key
   Do
      Multi Wait
      A$=Inkey$ : M=Mouse Click
      Exit If A$<>""
      Exit If M>0
   Loop
   Cls
End Proc
Procedure _GET_SYS_MOUSE
   '
   ' Version 1.0 ** Michael Sikorsky **  JAN/93
   '   shortened and modified JUN/93 for The Home Accountant
   '      by Vincent Platt
   '
   RET=True
   Hide
   If Not Exist("devs:system-configuration")
      N0TICE["You have no devs:system-configuration file.  No change made.",0]
      RET=False : Goto _ENDING
   End If
   Open In 1,"devs:system-configuration"
   Reserve As Work 5,120
   Sload 1 To Start(5),120
   Close 1
   '
   '  Select Which Sprite # you want the new mouse to be
   '
   MOUSE_IMAGE=1
   '
   ' get mouse colors
   '
   C18=(Deek(Start(5)+$66))
   C17=(Deek(Start(5)+$68))
   C19=(Deek(Start(5)+$6A))
   C16=(Deek(Start(5)+$6E))
   '
   ' Using the mouse colors only
   '
   Palette ,,,,,,,,,,,,,,,,C16,C17,C18,C19
   '
   ' Open Up a screen to work with
   '
   Screen Open 7,16,16,4,Hires
   Screen Hide 7
   '
   '  Draw image on screen
   '
   For Y=0 To 15
      '
      ' read in the bitplanes...
      '   A$ =holds the bits for the first  bitplane
      '   A1$=  "    "    "   "   "  second    "
      '
      A$=Bin$(Deek(Start(5)+$20+4*Y),16)
      A1$=Bin$(Deek(Start(5)+$22+4*Y),16)
      '
      For X=2 To 17

         '
         ' t$ holds the a bit on the 1st bitplane and
         ' the corresponding bit on the 2nd bitplane
         '
         T$=Mid$(A$,X,1)+Mid$(A1$,X,1)

         If T$="00"
            C=0
         Else
            If T$="01"
               C=1
            Else
               If T$="10"
                  C=2
               Else
                  If T$="11"
                     C=3
                  End If
               End If
            End If
         End If
         '
         '
         Ink C : Plot X-2,Y
      Next
      '
   Next
   '
   ' Get the image for the new mouse
   '
   Get Bob MOUSE_IMAGE,0,0 To 0+16,0+16
   '
   '
   ' figure out where the HotSpot is
   '
   ' read in 2 bytes ( eg. FF & FE )
   HX$=Hex$(Peek(Start(5)+$64))
   HY$=Hex$(Peek(Start(5)+$65))
   '
   HX$=Mid$(HX$,Len(HX$),1)
   HY$=Mid$(HY$,Len(HY$),1)
   '
   HX=Instr("FEDCBA9876543210",HX$,0)-1
   HY=Instr("0FEDCBA987654321",HY$,0)-1
   '
   Hot Spot MOUSE_IMAGE,HX,HY
   Change Mouse 3+MOUSE_IMAGE

   '
   ' close the work screen
   Screen Close 7
   ' display the new mouse
   Show
   '
   Erase 5 : DUMMY=Free
   '
   _ENDING:
End Proc[RET]
'*************************  procs end  **********************************